home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / DNR.p < prev    next >
Encoding:
Text File  |  1995-10-23  |  7.7 KB  |  309 lines  |  [TEXT/CWIE]

  1. unit DNR;
  2.  
  3. interface
  4.  
  5.     uses
  6.         TCPTypes;
  7.  
  8.     type
  9.         ResultProcPtr = UniversalProcPtr;
  10. { procedure ResultProc(hip:hostInfoPtr; userdata:ptr); }
  11.         ResultProc2Ptr = UniversalProcPtr;
  12. { procedure ResultProc2(hmxip:HMXInfoPtr; userdata:ptr); }
  13.         EnumResultProcPtr = UniversalProcPtr;
  14. { procedure EnumResultProc(cerp:cacheEntryRecordPtr; userdata:ptr); }
  15.  
  16.     function OpenResolver: OSErr;
  17.     procedure CloseResolver;
  18.     function StrToAddr (host: Str255; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  19.     procedure AddrToStr (addr: longint; var s: Str255);
  20.     function EnumCache (completion: EnumResultProcPtr; userdata: ptr): OSErr;
  21.     function AddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: ptr): OSErr;
  22.     function HInfo (host: Str255; var hi: hmxInfoRec; completion: ResultProc2Ptr; userdata: ptr): OSErr;
  23.     function MXInfo (host: Str255; var mxi: hmxInfoRec; completion: ResultProc2Ptr; userdata: ptr): OSErr;
  24.  
  25. implementation
  26.  
  27.     uses
  28.         Resources, Errors, Memory, Folders, MyCallProc, MyCStrings;
  29.  
  30.     const
  31.         kOPENRESOLVER = 1;
  32.         kCLOSERESOLVER = 2;
  33.         kSTRTOADDR = 3;
  34.         kADDRTOSTR = 4;
  35.         kENUMCACHE = 5;
  36.         kADDRTONAME = 6;
  37.         kHINFO = 7;
  38.         kMXINFO = 8;
  39.         
  40.     var
  41.         code: Handle;
  42.  
  43.     procedure GetSystemFolder (var vrn: integer; var dirID: longint);
  44.     begin
  45.         if FindFolder(kOnSystemDisk, kSystemFolderType, false, vrn, dirID) <> noErr then begin
  46.             vrn := 0;
  47.             dirID := 0;
  48.         end;
  49.     end;
  50.  
  51.     procedure GetCPanelFolder (var vrn: integer; var dirID: longint);
  52.     begin
  53.         if FindFolder(kOnSystemDisk, kControlPanelFolderType, false, vrn, dirID) <> noErr then begin
  54.             vrn := 0;
  55.             dirID := 0;
  56.         end;
  57.     end;
  58.  
  59. { SearchFolderForDNRP is called to search a folder for files that might }
  60. { contain the 'dnrp' resource }
  61.     function SearchFolderForDNRP (ftype, fcreator: OSType; vrn: integer; dirID: longint): Handle;
  62.         var
  63.             pb: HParamBlockRec;
  64.             filename: Str63;
  65.             refnum: integer;
  66.             i: integer;
  67.             hhhh: Handle;
  68.             err: OSErr;
  69.     begin
  70.         hhhh := nil;
  71.         i := 1;
  72.         repeat
  73.             pb.ioNamePtr := @filename;
  74.             pb.ioVRefNum := vrn;
  75.             pb.ioDirID := dirID;
  76.             pb.ioFDirIndex := i;
  77.             i := i + 1;
  78.             err := PBHGetFInfoSync(@pb);
  79.             if err = noErr then begin
  80.                 if (pb.ioFlFndrInfo.fdType = ftype) & (pb.ioFlFndrInfo.fdCreator = fcreator) then begin
  81.                     SetResLoad(false);
  82.                     refnum := HOpenResFile(vrn, dirID, filename, fsRdPerm);
  83.                     SetResLoad(true);
  84.                     if refnum <> -1 then begin
  85.                         hhhh := Get1IndResource('dnrp', 1);
  86.                         if hhhh <> nil then begin
  87.                             DetachResource(hhhh);
  88.                         end;
  89.                         CloseResFile(refnum);
  90.                     end;
  91.                 end;
  92.             end;
  93.         until (err <> noErr) or (hhhh <> nil);
  94.         SearchFolderForDNRP := hhhh;
  95.     end;
  96.  
  97.     function SearchForDNRP: Handle;
  98.         var
  99.             hhhh: Handle;
  100.             vrn: integer;
  101.             dirID: longint;
  102.     begin
  103. { first search Control Panels for MacTCP 1.1 }
  104.         GetCPanelFolder(vrn, dirID);
  105.         hhhh := SearchFolderForDNRP('cdev', 'ztcp', vrn, dirID);
  106.  
  107.         if hhhh = nil then begin
  108. { next search System Folder for MacTCP 1.0.x }
  109.             GetSystemFolder(vrn, dirID);
  110.             hhhh := SearchFolderForDNRP('cdev', 'mtcp', vrn, dirID);
  111.         end;
  112.  
  113.         if hhhh = nil then begin
  114. { then search Control Panels for MacTCP 1.0.x }
  115.             GetCPanelFolder(vrn, dirID);
  116.             hhhh := SearchFolderForDNRP('cdev', 'mtcp', vrn, dirID);
  117.         end;
  118.  
  119.         if hhhh = nil then begin
  120. { finally, look in any open resource file }
  121.             hhhh := Get1IndResource('dnrp', 1);
  122.             if hhhh <> nil then begin
  123.                 DetachResource(hhhh);
  124.             end;
  125.         end;
  126.  
  127.         SearchForDNRP := hhhh;
  128.     end;
  129.  
  130.     function CallOpenResolver: OSErr;
  131.         var
  132.             proc:UniversalProcPtr;
  133.     begin
  134.         proc:=New68kProc(code^,uppC244ProcInfo);
  135.         CallOpenResolver := CallC244(nil, kOPENRESOLVER,proc);
  136.         DisposeRoutineDescriptor(proc);
  137.     end;
  138.  
  139.     function OpenResolver: OSErr;
  140.         var
  141.             err: OSErr;
  142.     begin
  143.         code := SearchForDNRP;
  144.         if code = nil then begin
  145.             err := resNotFound;
  146.         end else begin
  147.             HLock(code);
  148.             err := CallOpenResolver;
  149.             if err <> noErr then begin
  150.                 DisposeHandle(code);
  151.                 code := nil;
  152.             end;
  153.         end;
  154.         OpenResolver := err;
  155.     end;
  156.  
  157.     function CallCloseResolver:OSErr;
  158.         var
  159.             proc:UniversalProcPtr;
  160.     begin
  161.         proc:=New68kProc(code^,uppC24ProcInfo);
  162.         CallCloseResolver := CallC24(kCLOSERESOLVER,proc);
  163.         DisposeRoutineDescriptor(proc);
  164.     end;
  165.  
  166.     procedure CloseResolver;
  167.         var
  168.             junk:OSErr;
  169.     begin
  170.         if code <> nil then begin
  171.             junk:=CallCloseResolver;
  172.             DisposeHandle(code);
  173.         end;
  174.     end;
  175.  
  176.     function CallStrToAddr (cname: CStringPtr; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: ptr): OSErr;
  177.         var
  178.             proc:UniversalProcPtr;
  179.     begin
  180.         proc:=New68kProc(code^,uppC244444ProcInfo);
  181.         CallStrToAddr := CallC244444(userdata,completion,@rtnStruct,cname,kSTRTOADDR,proc);
  182.         DisposeRoutineDescriptor(proc);
  183.     end;
  184.  
  185.     function StrToAddr (host: Str255; var rtnStruct: hostInfo; completion: ResultProcPtr; userdata: Ptr): OSErr;
  186.         var
  187.             err: OSErr;
  188.     begin
  189.         if code = nil then begin
  190.             err := notOpenErr;
  191.         end else begin
  192.             P2C(@host);
  193.             err := CallStrToAddr(@host, rtnStruct, completion, userdata);
  194.         end;
  195.         StrToAddr := err;
  196.     end;
  197.  
  198.     function CallAddrToStr(addr: longint; cstr: CStringPtr):OSErr;
  199.         var
  200.             proc:UniversalProcPtr;
  201.     begin
  202.         proc:=New68kProc(code^,uppC2444ProcInfo);
  203.         CallAddrToStr := CallC2444(cstr, addr, kADDRTOSTR, proc);
  204.         DisposeRoutineDescriptor(proc);
  205.     end;
  206.  
  207.     procedure AddrToStr (addr: longint; var s: Str255);
  208.         var
  209.             junk:OSErr;
  210.             len: integer;
  211.     begin
  212.         if code <> nil then begin
  213.             junk := CallAddrToStr(addr, @s);
  214.             len := 0;
  215.             while (s[len] <> chr(0)) & (len < 255) do begin
  216.                 len := len + 1;
  217.             end;
  218.             BlockMoveData(@s, @s[1], len);
  219.             s[0] := chr(len);
  220.         end;
  221.     end;
  222.  
  223.     function CallEnumCache (completion: EnumResultProcPtr; userdata: ptr): OSErr;
  224.         var
  225.             proc:UniversalProcPtr;
  226.     begin
  227.         proc:=New68kProc(code^,uppC2444ProcInfo);
  228.         CallEnumCache := CallC2444(userdata, completion, kENUMCACHE, proc);
  229.         DisposeRoutineDescriptor(proc);
  230.     end;
  231.  
  232.     function EnumCache (completion: EnumResultProcPtr; userdata: ptr): OSErr;
  233.         var
  234.             err: OSErr;
  235.     begin
  236.         if code = nil then begin
  237.             err := notOpenErr;
  238.         end else begin
  239.             err := CallEnumCache(completion, userdata);
  240.         end;
  241.         EnumCache := err;
  242.     end;
  243.  
  244.     function CallAddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: ptr): OSErr;
  245.         var
  246.             proc:UniversalProcPtr;
  247.     begin
  248.         proc:=New68kProc(code^,uppC244444ProcInfo);
  249.         CallAddrToName := CallC244444(userdata, completion, @hi, addr, kADDRTONAME, proc);
  250.         DisposeRoutineDescriptor(proc);
  251.     end;
  252.  
  253.     function AddrToName (addr: longint; var hi: hostInfo; completion: ResultProcPtr; userdata: ptr): OSErr;
  254.         var
  255.             err: OSErr;
  256.     begin
  257.         if code = nil then begin
  258.             err := notOpenErr;
  259.         end else begin
  260.             err := CallAddrToName(addr, hi, completion, userdata);
  261.         end;
  262.         AddrToName := err;
  263.     end;
  264.  
  265.     function CallHInfo (name: CStringPtr; var hi: hmxInfoRec; completion: ResultProc2Ptr; userdata: ptr): OSErr;
  266.         var
  267.             proc:UniversalProcPtr;
  268.     begin
  269.         proc:=New68kProc(code^,uppC244444ProcInfo);
  270.         CallHInfo := CallC244444(userdata, completion, @hi, @name, kHINFO, proc);
  271.         DisposeRoutineDescriptor(proc);
  272.     end;
  273.  
  274.     function HInfo (host: Str255; var hi: hmxInfoRec; completion: ResultProc2Ptr; userdata: ptr): OSErr;
  275.         var
  276.             err: OSErr;
  277.     begin
  278.         if code = nil then begin
  279.             err := notOpenErr;
  280.         end else begin
  281.             P2C(@host);
  282.             err := CallHInfo(@host, hi, completion, userdata);
  283.         end;
  284.         HInfo := err;
  285.     end;
  286.  
  287.     function CallMXInfo (name: CStringPtr; var hi: hmxInfoRec; completion: ResultProc2Ptr; userdata: ptr): OSErr;
  288.         var
  289.             proc:UniversalProcPtr;
  290.     begin
  291.         proc:=New68kProc(code^,uppC244444ProcInfo);
  292.         CallMXInfo := CallC244444(userdata, completion, @hi, @name, kMXINFO, proc);
  293.         DisposeRoutineDescriptor(proc);
  294.     end;
  295.  
  296.     function MXInfo (host: Str255; var mxi: hmxInfoRec; completion: ResultProc2Ptr; userdata: ptr): OSErr;
  297.         var
  298.             err: OSErr;
  299.     begin
  300.         if code = nil then begin
  301.             err := notOpenErr;
  302.         end else begin
  303.             P2C(@host);
  304.             err := CallMXInfo(@host, mxi, completion, userdata);
  305.         end;
  306.         MXInfo := err;
  307.     end;
  308.  
  309. end.